perm filename RESPS.SAI[PUB,TES]1 blob
sn#129307 filedate 1974-11-03 generic text, type T, neo UTF8
00100 BEGOF("RESPS")
00200
00300
00400 COMMENT
00500
00600 Each variety of response has its own linked list of RESPTYPE records
00700 with currently declared responses. Each record has an OLD!RESP link
00800 to outer block versions of the same response. Calling a response is
00900 tricky, especially in the midst of a text line --- the state must be
01000 preserved and restored carefully.
01100
01200 ;
01300
01400 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE RESPS! ;$"#
00200 BEGIN "RESPS!"
00300 GENSYM ← LEADRESPS ← WAITRESP ← 0 ;
00400 RESP!BODY ← FALSE ;
00500 END "RESPS!" ;
00100 PUBLIC RECURSIVE BOOLEAN PROCEDURE ATLEAD(INTEGER LEADSPACES) ;$"#
00200 BEGIN
00300 IF FINDINSET(LEADSPACES) AND FULSTR(SSTK[BODY(LLTHIS)])THEN RESPOND(LLTHIS)
00400 ELSE RETURN(FALSE) ;
00500 RETURN(TRUE) ;
00600 END "ATLEAD" ;
00100 PUBLIC RECURSIVE PROCEDURE CLOSET(INTEGER ITSIX; BOOLEAN CLOSEIT, DISDECLAREIT) ;$"#
00200 BEGIN "CLOSET"
00300 IF DISDECLAREIT THEN DBREAK ;
00400 IF FINDTRAN(LDB(BIXNUM(ITSIX)), 3) THEN
00500 IF CLOSEIT AND ITSIX NEQ IXPAGE AND comment AFTER ;
00600 (IXTYPE(ITSIX)=AREATYPE OR FULSTR(CTR!VAL(PATT!STRS(ITSIX)))) THEN RESPOND(LLTHIS) ;
00700 IF DISDECLAREIT THEN DISD(ITSIX) ← -1 ;
00800 END "CLOSET" ;
00100 PUBLIC SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD) ;$"#
00200 BEGIN
00300 INTEGER ARGS, SIHIGH, L1, L2, SIG, CLU, VARI, S, A, RIX, J, TYP, XIX, OLDIX ;
00400 STRING PHR, X, BOD ; BOOLEAN ROTTEN, HASBODY ;
00500 SIMPLE PROCEDURE RESPREPL ;
00600 BEGIN
00700 RIX ← PUSHI(RESPWDS, RESPTYPE) ;
00800 NEXT!RESP(RIX) ← LLPOST ; OLD!RESP(RIX) ← LLTHIS ;
00900 END "RESPREPL" ;
01000 ROTTEN ← FALSE ; ARGS ← 0 ; SIHIGH ← IHIGH ;
01100 IF COMDWD = 1 THEN
01200 BEGIN "AT"
01300 PASS ;
01400 IF ITS(PAGEMARK) THEN BEGIN VARI←2 ; CLU←0 ; L1←FF ; SIG←FF ROT -7 ; PASS END
01500 ELSE BEGIN
01600 X ← SIMPAR ; L1 ← X ;
01700 IF NULSTR(X) THEN BEGIN VARI←2 ; CLU←0 ; L1←CR ; SIG←CR ROT -7 ; PASS END
01800 ELSE IF THISWD[1 FOR 1]="0" THEN BEGIN VARI←1 ; CLU←CVD(X) ; PASS END
01900 TES 11/15/73: TEST ABOVE USED TO BE "0" LEQ L1 LEQ "9".
02000 ALSO, TOOK OUT "PHRASE RESPONSE", VARI=0;
02100 ELSE BEGIN VARI ← 2 ; L1 ← X ; SIG ← CVASC(X) ; CLU ← LENGTH(X) ;
02200 DPASS ; A ← 0 ;
02300 WHILE NOT (ITSCH(;) OR ITSCH(⊂)) DO
02400 BEGIN
02500 IF NOT THISISID THEN
02600 BEGIN
02700 WARN("=","Argument must be identifier.") ;
02800 ROTTEN←TRUE ;
02900 END ;
03000 S←SYMB ; PASS ; IF LENGTH(X←SIMPAR) NEQ 1 THEN WARN("=","Separator 1 character only");
03100 PUTI(1, S) ; A ← A LSH 7 LOR X ; DPASS ;
03200 END ;
03300 ARGS ← IHIGH - SIHIGH ;
03400 IF ARGS>5 THEN
03500 BEGIN TES 8/26/74 ;
03600 IHIGH ← SIHIGH + 5 ;
03700 WARN(NULL, <"SORRY, I FORGOT TO TELL YOU..." & CRLF &
03800 "THERE IS A 5 ARGUMENT LIMIT ON SIGNAL RESPONSES, WHICH YOU HAVE VIOLATED" & CRLF &
03900 "MACROS AND PROCEDURES ARE BETTER ANYWAY.">) ;
04000 END ;
04100 END ;
04200 END ;
04300 END "AT"
04400 ELSE BEGIN
04500 PASS ; IF NOT THISISID THEN BEGIN WARN("=","BEFORE/AFTER need area/counter name") ; ROTTEN←TRUE END
04600 ELSE BEGIN VARI←IF COMDWD THEN 3 ELSE 4; CLU←SYMB; TYP←THISTYPE; XIX←IX; PASS END ;
04700 END ;
04800 BOD ← DEFN(FALSE, FALSE,ARGS,SIHIGH) ; OLDIX ← RIX ← -1 ;
04900 IF ROTTEN OR NOT ON THEN BEGIN IHIGH ← SIHIGH ; RETURN END ;
05000 X ← BOD ; SCAN(X, TO!NON!SP, HASBODY) ; IF NOT HASBODY THEN BOD ← NULL ;
05100 CASE VARI-1 MIN 2 OF
05200 BEGIN
05300 COMMENT 0... Phrase TES 11/15/73 removed this case ;
05400 COMMENT 1 ... Inset ;IF FINDINSET(CLU) THEN
05500 IF DEPTH!RESP(LLTHIS) < DEPTH THEN
05600 BEGIN
05700 RESPREPL ;
05800 IF LLPREV<0 THEN LEADRESPS←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
05900 END
06000 ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS TES 11/29/73 OLDIX;
06100 ELSE BEGIN
06200 OLDIX ← LLTHIS ; TES 11/29/73 ;
06300 LLSKIP(LEADRESPS, <NEXT!RESP>)
06400 END
06500 ELSE BEGIN
06600 RIX←PUSHI(RESPWDS,RESPTYPE) ;
06700 LLINS(LEADRESPS,<NEXT!RESP>,RIX) ;
06800 END ;
06900 COMMENT 2 ... Signal;BEGIN S ← 0 ; comment Old response of same signal: >0 for outer block, <0 same block;
07000 IF FINDSIGNAL(SIG) THEN
07100 BEGIN
07200 S ← IF DEPTH!RESP(LLTHIS) < DEPTH THEN LLTHIS ELSE -LLTHIS ;
07300 IF S<0 THEN OLDIX ← LLTHIS; TES 11/29/73 ;
07400 LLSKIP(SIGNALD[L1], <NEXT!RESP>) ; LLTHIS ← LLPOST ;
07500 END ;
07600 IF HASBODY OR S > 0 THEN
07700 BEGIN
07800 RIX←PUSHI(SIGWDS,RESPTYPE); SIGNAL(RIX)←SIG ; NUMARGS(RIX) ← ARGS ;
07900 LLINS(SIGNALD[L1], <NEXT!RESP>, RIX) ; RESP!SEP(RIX) ← A ;
08000 IF S = 0 THEN SIG!BRC ← (SIG LSH -29) & SIG!BRC ; OLD!RESP(RIX) ← S MAX 0;
08100 END ;
08200 IF NULSTR(BOD) AND S THEN
08300 BEGIN
08400 X ← NULL ;
08500 WHILE FULSTR(SIG!BRC) AND (A ← LOP(SIG!BRC)) NEQ L1 DO X ← X & A ;
08600 SIG!BRC ← X & SIG!BRC ;
08700 END ;
08800 SETBREAK(TEXT!TBL, TEXT!BRC&SIG!BRC, NULL, "IS") ;
08900 END ;
09000 COMMENT 3,4... AFTER/BEFORE area|counter ;
09100 IF FINDTRAN(CLU, VARI) THEN
09200 IF DEPTH!RESP(LLTHIS) < DEPTH THEN
09300 BEGIN
09400 RESPREPL ;
09500 IF LLPREV < 0 THEN WAITRESP←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
09600 END
09700 ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS
09800 ELSE BEGIN
09900 OLDIX ← LLTHIS ; TES 11/29/73 ;
10000 LLSKIP(WAITRESP, <NEXT!RESP>)
10100 END
10200 ELSE BEGIN
10300 RIX←PUSHI(RESPWDS,RESPTYPE) ;
10400 LLINS(WAITRESP,<NEXT!RESP>,RIX) ;
10500 END ;
10600 END ;
10700 IF OLDIX GEQ 0 THEN SSTK[BODY(OLDIX)] ← NULL ; TES 11/29/73 GC ;
10800 IF RIX GEQ 0 THEN
10900 BEGIN
11000 CLUE(RIX) ← CLU ; VARIETY(RIX) ← VARI ;
11100 BODY(RIX) ← PUSHS(1,BOD) ; DEPTH!RESP(RIX) ← DEPTH ;
11200 END ;
11300 END "DRESPONSE" ;
00100 PUBLIC BOOLEAN SIMPLE PROCEDURE FINDINSET(INTEGER HM) ;$"#
00200 BEGIN "FINDINSET"
00300 INTEGER ARE ;
00400 LLSCAN(LEADRESPS, <NEXT!RESP>, <(ARE ← CLUE(LLTHIS)) GEQ HM>) ;
00500 RETURN(LLTHIS AND ARE = HM) ;
00600 END "FINDINSET" ;
00100 PUBLIC INTEGER SIMPLE PROCEDURE FINDSIGNAL(INTEGER SIGASC) ;$"#
00200 BEGIN "FINDSIGNAL"
00300 INTEGER CHR ;
00400 CHR ← SIGASC LSH -29 ;
00500 LLSCAN(<SIGNALD[CHR]>, <NEXT!RESP>, <SIGASC = SIGNAL(LLTHIS)>) ;
00600 RETURN(LLTHIS) ;
00700 END "FINDSIGNAL" ;
00100 PUBLIC INTEGER SIMPLE PROCEDURE FINDTRAN(INTEGER UASYMB, VARI) ;$"#
00200 BEGIN "FINDTRAN"
00300 LLSCAN(WAITRESP, <NEXT!RESP>,
00400 <CLUE(LLTHIS) = UASYMB AND (VARI=0 OR VARIETY(LLTHIS)=VARI)>) ;
00500 RETURN(LLTHIS) ;
00600 END "FINDTRAN" ;
00100 PUBLIC RECURSIVE PROCEDURE RESPOND(INTEGER IX) ;$"#
00200 IF ON THEN
00300 BEGIN "RESPOND"
00400 INTEGER ARGS ; STRING COM!ENT ;
00500 ARGS ← IF VARIETY(IX) = 2 THEN NUMARGS(IX) ELSE 0 ;
00600 IF VARIETY(IX) < 3 AND IX NEQ SIGNALD[FF] THEN
00700 BEGIN "AT"
00800 SWICH(IF IX=SIGNALD[CR] THEN SSTK[BODY(IX)] ELSE ALTMODE&SSTK[BODY(IX)]&RCBRAK, -1, ARGS) ;
00900 RETURN ;
01000 END "AT" ;
01100 GENSYM←GENSYM+1 ; COM!ENT ← "!?@"&CVS(GENSYM) ;
01200 BEGINBLOCK( TRUE, 3 , COM!ENT ) ;
01300 SWICH(SSTK[BODY(IX)]&(CRLF&TB&TB&"END """)&COM!ENT&""";;", -1, ARGS) ;
01400 PASS ; TOEND ;
01500 END "RESPOND" ;
00100 PUBLIC BOOLEAN SIMPLE PROCEDURE SIGNA(INTEGER SIGCH1) ;$"#
00200 BEGIN
00300 INTEGER ARG, RIX, ARGS, SEPS ; STRING SEE ;
00400 SEE ← SIGCH1 & INPUTSTR ;
00500 LLSCAN(<SIGNALD[SIGCH1]>, <NEXT!RESP>, <CVASC(SEE[1 FOR CLUE(LLTHIS)])=SIGNAL(LLTHIS)>) ;
00600 IF LLTHIS = 0 THEN RETURN(FALSE) ; RIX ← LLTHIS ; ARGS ← NUMARGS(RIX) ;
00700 INPUTSTR ← INPUTSTR[CLUE(RIX) TO ∞] ;
00800 IF ARGS THEN BEGIN "SCAN ARGS"
00900 SEPS ← RESP!SEP(RIX) ; IF LAST + ARGS > SIZE THEN GROWNESTS ;
01000 FOR ARG ← 1 THRU ARGS DO
01100 BEGIN "SEPBREAK"
01200 SETBREAK(LOCAL!TABLE,
01300 (SEPS LSH ((ARG-ARGS)*7) LAND '177) & CRLF, NULL, "IS") ;
01400 SEE ← NULL ;
01500 DO BEGIN
01600 SEE ← SEE & RD(LOCAL!TABLE) ;
01700 IF BRC = CR THEN
01800 BEGIN
01900 IF FULSTR(RD(TO!NON!SP)) OR BRC NEQ RCBRAK
02000 OR INPUTSTR[2 FOR 1] NEQ VT THEN DONE ;
02100 LOPP(INPUTSTR) ; LOPP(INPUTSTR) ; IF FULSTR(SEE) THEN SEE ← SEE & SP ;
02200 END
02300 ELSE BRC ← -1 ;
02400 END UNTIL BRC < 0 ;
02500 SNEST[LAST + ARG] ← SEE ;
02600 IF BRC > 0 THEN
02700 BEGIN
02800 WARN("=","Missing Signal Separator") ;
02900 FOR ARG ← ARG+1 THRU ARGS DO SNEST[LAST+ARG] ← NULL ;
03000 END ;
03100 END "SEPBREAK" ;
03200 IF ON THEN LAST ← LAST + ARGS ; COMMENT "IF" JAN 9 1973 ;
03300 END "SCAN ARGS" ;
03400 RESPOND(RIX) ; RETURN(TRUE) ;
03500 END "SIGNA" ;
00100 FINISHED
00200
00300 ENDOF("RESPS")